home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Crack It!
/
Crack It!.iso
/
CONTENT
/
DISKEDIT
/
SCREENRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-09
|
5KB
|
190 lines
{
***
SCREENRT.PAS
Screen-related Routines
(C)Copyright Gerard Paul Java 1996
Unit Source File
Licensed material - program property of Fencer Software
This unit contains general routines related to the screen. It contains
a box-drawing routine, the screen save/restore routines, a function that
returns a string of a particular character repeated, cursor-manipulation
routines, and the routines that save, set, and restore the screen mode.
It also contains a routine that sets both foreground and background colors
at once.
***
}
{$A+,B-,F-,I-,N-,R-,S-,V-}
unit ScreenRt;
interface
type
OrigWindowType = object
Min: word;
Max: word;
procedure Save;
procedure Restore;
end;
ReptStrLenRange = 1..80;
Str80 = string[80];
Str78 = string[78];
ScreenBufferType = array[1..2000] of word; { Buffer for screen saves/restores. }
const
SingleLine = False;
DoubleLine = True;
var
BoxAttr : byte;
TextNormAttr: byte;
TextHighAttr: byte;
function StringOf(Character: char;Count: ReptStrLenRange): Str80;
procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
procedure DivideBox(Col,Top,Bottom: byte);
procedure SetCursor(ScanLines: word);
inline($B4/$01/ { MOV AH,1 }
$59/ { POP CX ;ScanLines were pushed. }
$CD/$10); { INT $10 }
procedure PutChar(X,Y,Character: byte);
procedure SetTSSRValues;
procedure SaveScreen(var ScreenBuffer: ScreenBufferType);
procedure RestoreScreen(var ScreenBuffer: ScreenBufferType);
implementation
uses
Crt;
const
Space = ' ';
Null = '';
{---------------------------------------------------------------------------
StringOf: Returns a string consisting of Count occurences of a character.
---------------------------------------------------------------------------}
function StringOf(Character: char;Count: ReptStrLenRange): Str80; external;
{$L STRINGOF.OBJ}
{---------------------------------------------------------------------------
Box: Creates a box on the screen. The box has spaces within it, so any
characters on the screen within the boundaries of the box are erased. The
high-level ASCII characters ╔ (201), ╗ (187), ╚ (200), ╝ (188), ═ (205),
and ║ (186) are used to create the box.
---------------------------------------------------------------------------}
procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
var
ULeftChar,
LLeftChar,
URightChar,
LRightChar,
HorBarChar,
VerBarChar: char;
Wid : byte;
Row : byte;
HorzBar : Str78;
InSpaces : Str78;
begin { proc }
case Style of
SingleLine: begin
ULeftChar := #218;
LLeftChar := #192;
URightChar := #191;
LRightChar := #217;
HorBarChar := #196;
VerBarChar := #179;
end;
DoubleLine: begin
ULeftChar := #201;
LLeftChar := #200;
URightChar := #187;
LRightChar := #188;
HorBarChar := #205;
VerBarChar := #186;
end;
end;
Wid := X2-X1-1; { Calculate box width. }
HorzBar := StringOf(HorBarChar,Wid);
InSpaces := StringOf(Space,Wid);
GotoXY(X1,Y1);Write(ULeftChar,HorzBar,URightChar);
for Row := Y1+1 to Y2-1 do
begin { for }
GotoXY(X1,Row);
Write(VerBarChar,InSpaces,VerBarChar);
end; { for }
GotoXY(X1,Y2);Write(LLeftChar,HorzBar,LRightChar);
end; { proc }
procedure DivideBox(Col,Top,Bottom: byte);
var
Ctr: byte;
begin
GotoXY(Col,Top);Write(#209);
GotoXY(Col,Bottom);Write(#207);
for Ctr := Top+1 to Bottom-1 do
begin
GotoXY(Col,Ctr);Write(#179);
end;
end;
procedure OrigWindowType.Save;
begin
Min := WindMin;
Max := WindMax;
end;
procedure OrigWindowType.Restore;
begin
WindMin := Min;
WindMax := Max;
end;
{---------------------------------------------------------------------------
These are the external screen save/restore routines. SetTSSRValues
determines the video configuration and sets the proper values for the
screen segment and other variables to work with. SaveScreen saves the
screen in a 2000-word array variable, and RestoreScreen copies the contents
of the array variable back to the screen.
---------------------------------------------------------------------------}
{$L PUTCHAR.OBJ}
procedure PutChar; external;
{$L TSSR.OBJ} { Link in screen save/restore routines. }
procedure SetTSSRValues; external;
procedure SaveScreen; external;
procedure RestoreScreen; external;
end.